home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / pkey12_1.zip / GRD.LSP < prev    next >
Text File  |  1992-09-13  |  1KB  |  33 lines
  1. ;Grid for whatever you want to use it for.
  2. ;
  3. ;
  4. (setq oer *error* *error* err)
  5. (pre)
  6. (if(= grdx nil)(setq *grdx 24))
  7. (setq grdx(getreal(strcat"Horizontal grid size <"(rtos *grdx)">: ")))
  8. (if(= grdx nil)(setq grdx *grdx)(setq *grdx grdx))
  9. (if(= grdy nil)(setq *grdy 48))
  10. (setq grdy(getreal(strcat"Vertical grid size <"(rtos *grdy)">: ")))
  11. (if(= grdy nil)(setq grdy *grdy)(setq *grdy grdy))
  12. (setq p1(getpoint"Pick lower left: "))
  13. (setq p0(getpoint"Pick upper right: "))
  14. (setq c(distance p1 p0))
  15. (setq a1(angle p1 p0))
  16. (setq b(* c(sin a1)))
  17. (setq a(* c(cos a1)))
  18. (setq gx(-(fix(/ a grdx))1))
  19. (if(= gx 0)(setq gx(+ gx 1)))
  20. (setq d(/(- a(* gx grdx))2))
  21. (setq p2(list(+(car p1)d)(cadr p1)))
  22. (setq p3(list(car p2)(+(cadr p2)b)))
  23. (setq gy(-(fix(/ b grdy))1))
  24. (if(= gy 0)(setq gy(+ gy 1)))
  25. (setq yb(/(- b(* gy grdy))2))
  26. (setq p4(list(car p1)(+(cadr p1)yb)))
  27. (setq p5(list(+(car p4)a)(cadr p4)))
  28. (command "line" p2 p3 "")
  29. (command "array" "l" "" "r" "1"(+ gx 1)grdx)
  30. (command "line" p4 p5 "")
  31. (command "array" "l" "" "r"(+ gy 1)"1" grdy)
  32. (post)
  33. (princ)